Sub duplicateMySection()
' vA8Mj9pF7Av5
    Dim sectionName(1 To 100, 1 To 2)
    Dim mySection As String
    Dim rng As Word.Range
    Dim pars
    Dim sourceFileName As String
    Dim targetFileName As String
    Dim targetFile
    Dim nextPos
    Dim startLocation
    Dim endLocation
    
    
    sectionName(1, 1) = "START"
    sectionName(2, 1) = "END"
    sectionName(3, 1) = "ZTE-SZ PTN 6200-6300 Programs"
    sectionName(4, 1) = "ZTE-SZ MSTP Programs"
    sectionName(5, 1) = "Huawei Project (WP3)"
    sectionName(6, 1) = "Ericsson Project OMS1410 (BJ WP3+UFE4)"
    sectionName(7, 1) = "Ericsson SGSN Project(SH WP3+UFE4)"
    sectionName(8, 1) = "ZTE-NJ G9000 and 6130 Programs"
    sectionName(9, 1) = "ZTE-NJ T8000  Programs"
    sectionName(10, 1) = "Huawei UFE4"
    sectionName(11, 1) = "ASB ISAM 7353 MDU and ISAM 7342 TDM over PON Projects"
    sectionName(12, 1) = "Raisecom Project (WP3)"
    sectionName(13, 1) = "Datang project"
    sectionName(14, 1) = "ECI Project"
    sectionName(15, 1) = "ASB LTE"
    sectionName(16, 1) = "ZTE-SZ PTN 6120 Program  (Main board WP3)"
    sectionName(17, 1) = "ZTE-SZ PTN 6120 Program   (16E1 Line Card WP3-SL)"
    
    
    
    
    
    sourceFileName = Application.Documents(1)
    
    Set targetFile = Application.Documents.Add
    targetFileName = targetFile.Name
    
    Application.Documents(sourceFileName).Activate
    
    startLocation = Application.Documents(sourceFileName).Content.Start
    endLocation = Application.Documents(sourceFileName).Content.End
    ' MsgBox "Start=" & startLocation & "end=" & endLocation
    Set rng = Application.Documents(sourceFileName).Range(Start:=startLocation, End:=endLocation)
    
    
    
    rng.Find.ClearFormatting
    
    sectionName(1, 2) = startLocation
    sectionName(2, 2) = endLocation
    For i = 3 To 17
        Set rng = Application.Documents(sourceFileName).Range(Start:=startLocation, End:=endLocation)
        rng.Find.ClearFormatting
        If rng.Find.Execute(sectionName(i, 1)) = True Then
            sectionName(i, 2) = rng.Start
            ' MsgBox "sectionName=" & sectionName(i, 1) & ", Pos(" & i & ")=" & rng.Start
        Else
            MsgBox "not found item=" & i
        End If
    Next
    
    
    mySection = sectionName(7, 1)
    
    
    rng.Find.ClearFormatting
    Set rng = Application.Documents(sourceFileName).Range(Start:=startLocation, End:=endLocation)
    If rng.Find.Execute(mySection) = True Then
        nextPos = findNextSub(rng.Start, sectionName)
        ' MsgBox "nextPos=" & nextPos
        Set rng = Application.Documents(sourceFileName).Range(Start:=rng.Start, End:=nextPos)
        rng.Select
        rng.Copy
        
        
        
        
        Application.Documents(targetFileName).Activate
        Selection.PasteAndFormat (wdListContinueNumbering)
        Selection.TypeParagraph

    End If
    
    Application.Documents(sourceFileName).Activate
    
    Set rng = Application.Documents(sourceFileName).Range(Start:=startLocation, End:=endLocation)
    mySection = sectionName(11, 1)
    rng.Find.ClearFormatting
    If rng.Find.Execute(mySection) = True Then
        nextPos = findNextSub(rng.Start, sectionName)
        MsgBox "nextPos=" & nextPos
        Set rng = Application.Documents(sourceFileName).Range(Start:=rng.Start, End:=nextPos)
        rng.Select
        rng.Copy
        targetFile.Activate
        
        Application.Documents(targetFileName).Activate
        Selection.TypeParagraph
        Selection.PasteAndFormat (wdListContinueNumbering)
        Selection.TypeParagraph
    End If
    
    
    
    
    
    
    
    Application.Documents(sourceFileName).Activate
    
    Set rng = Application.Documents(sourceFileName).Range(Start:=startLocation, End:=endLocation)
    mySection = sectionName(14, 1)
    rng.Find.ClearFormatting
    If rng.Find.Execute(mySection) = True Then
        MsgBox "rng.start=" & rng.Start
        nextPos = findNextSub(rng.Start, sectionName)
        ' MsgBox "nextPos=" & nextPos
        Set rng = Application.Documents(sourceFileName).Range(Start:=rng.Start, End:=nextPos)
        rng.Select
        rng.Copy
        targetFile.Activate
        
        Application.Documents(targetFileName).Activate
        Selection.TypeParagraph
        Selection.PasteAndFormat (wdListContinueNumbering)
        Selection.TypeParagraph
    End If
    
    
    
    
    
    
    
    
    
    
    
    
    
    
End Sub




Function findNextSub(ByVal currentItem, ByRef table)
    Dim i
    Dim nextItem
    
    
    For i = 1 To 14
        If table(i, 2) > currentItem Then
            nextItem = table(i, 2)
        End If
    Next

    nextItem = table(2, 2)

    For i = 1 To 15
        If table(i, 2) > currentItem Then
            If table(i, 2) < nextItem Then
                nextItem = table(i, 2)
            End If
        End If
    Next

    findNextSub = nextItem

End Function




